home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2005 October / PCWOCT05.iso / Software / FromTheMag / Ant Movie Catalog 3.5.0.2 / amc_install.exe / {app} / Scripts / All Movie Guide (pic).ifs < prev    next >
Text File  |  2005-04-12  |  17KB  |  471 lines
  1. (***************************************************
  2.  
  3. Ant Movie Catalog importation script
  4. www.antp.be/software/moviecatalog/
  5.  
  6. [Infos]
  7. Authors=Hubert Kosior, KaraGarga
  8. Title=All Movie Guide
  9. Description=All Movie Guide detailed info import with small picture
  10. Site=http://allmovie.com
  11. Language=EN
  12. Version=0.3 / 04.2005
  13. Requires=3.5.0
  14. Comments=send bugs and reports to: hubert@tm1.net|a bug corrected by Antoine Potten|to do:| - producer's name instad of producing company| - display movie categories when movie list hit (after searching)
  15. License=This program is free software; you can redistribute it and/or modify it under the  terms of the GNU General Public License as published by the Free Software Foundation;  either version 2 of the License, or (at your option) any later version. |
  16. GetInfo=1
  17.  
  18. [Options]
  19. CategoryOptions=3|3|1=Only import firts category|2=Import all categories and divide by "/"|3=Import all categories and divide by ","
  20. ProducerOptions=0|0|0=Import Production Companies into Producer Field|1=Import Theme into Producer Field|2=Import Tones into Producer Field|3=Import Moods into Producer Field|4=Import Releaser Company into Producer Field
  21. SynopsisOptions=2|1|1=Import into Description Field|2=Import into Comments Field|0=DO NOT import Synopsis
  22. ReviewOptions=2|2|1=Import into Description Field|2=Import into Comments Field|0=DO NOT import Review
  23. AwardsOptions=2|2|1=Import into Description Field|2=Import into Comments Field|0=DO NOT import Awards List
  24. CastOptions=3|3|1=Import Cast divided by ";"|2=Import Cast as a list (AMG Default)|3=Import Cast as a list (like IMDB)|4=Import Cast as a list within paranthesis|5=Import Cast within paranthesis
  25. FieldforCredits=2|2|0=DO NOT import Production Credits|1=Import Production Credits into Description Field|2=Import Production Credits into Comments Field
  26. CreditsOptions=2|2|1=Import Credits as a list (like AMG)|2=Import Credits as a list (like IMDB)|3=Import Credits as a list (within paranthesis)
  27.  
  28. ***************************************************)
  29.  
  30. program AllMovie;
  31. uses
  32.   StringUtils1;
  33. var
  34.   MovieName: string;
  35.  
  36. // simple string procedures
  37. function StringReplaceAll(S, Old, New: string): string;
  38. begin
  39.   while Pos(Old, S) > 0 do
  40.     S := StringReplace(S, Old, New);
  41.   Result := S;
  42. end;
  43. procedure CutAfter(var Str: string; Pattern: string);
  44. begin
  45.   Str := Copy(str, Pos(Pattern, Str) + Length(Pattern), Length(Str));
  46. end;
  47. procedure CutBefore(var Str: string; Pattern: string);
  48. begin
  49.   Str := Copy(Str, Pos(Pattern, Str), Length(Str));
  50. end;
  51.  
  52. // Loads and analyses page from internet (list of movies or direct hit)
  53. procedure AnalyzePage(Address: string);
  54. var
  55.   Page: TStringList;
  56. begin
  57.   Page := TStringList.Create;
  58.   Page.Text := GetPage(Address);
  59.   // movie list
  60.   Sleep(500);
  61.   if Pos('movie titles like: ', Page.Text) > 0 then
  62.   begin
  63.     PickTreeClear;
  64.     PickTreeAdd('Search results', '');
  65.     AddMoviesTitles(Page);
  66.     if PickTreeExec(Address) then
  67.       AnalyzePage(Address);
  68.   // refine search
  69.   end
  70.   else
  71.   if Pos('Sorry, there is too many possible matches, please adjust your search.', Page.Text) > 0 then
  72.   begin
  73.     ShowMessage('Sorry, there is too many possible matches, please adjust your search.');
  74.     if Input('All Movie Import', 'Enter the title of the movie:', MovieName) then
  75.       AnalyzePage('http://allmovie.com/cg/avg.dll?p=avg&type=2&srch=' + URLEncode(MovieName));
  76.   // direct hit
  77.   end
  78.   else
  79.   begin
  80.     if CanSetField(fieldURL) then SetField(FieldURL, Address);
  81.     AnalyzeMoviePage(Page)
  82.   end;
  83. end;
  84.  
  85. // Extracts movie details from page
  86. procedure AnalyzeMoviePage(MoviePage: TStringList);
  87. var
  88.   Page: string;
  89.   Value: string;
  90. begin
  91.   Page := MoviePage.Text;
  92. // Original title
  93. if CanSetField(fieldOriginalTitle) then
  94. begin
  95.   Value := TextBetween(Page, '<FONT SIZE="+2"><B>', '</B>');
  96.   SetField(fieldOriginalTitle, Value);
  97. end;
  98. // Year
  99. if CanSetField(fieldYear) then
  100. begin
  101.   SetField(fieldYear, GetStringFromHTML(Page, '<B>'+GetField(fieldOriginalTitle)+'</B>', '</TR>', '</B>'));
  102. end;
  103. // Country
  104. if CanSetField(fieldCountry) then
  105. begin
  106.   SetField(fieldCountry, GetStringFromHTML(Page, '<B>'+GetField(fieldOriginalTitle)+'</B>', '<I>', '</I>'));
  107. end;
  108. // Length
  109. if CanSetField(fieldLength) then
  110. begin
  111.   SetField(fieldLength, GetStringFromHTML(Page, '<B>'+GetField(fieldOriginalTitle)+'</B>', '</I> - ', ' min'));
  112. end;
  113. // AKA -> translated title
  114. if CanSetField(fieldTranslatedTitle) then
  115. begin
  116.   SetField(fieldTranslatedTitle, GetStringFromHTML(Page, '>AKA', '</TD>', '</td>'));
  117. end;
  118. // Rating (multiplied by 2, because 0 <= AMG rating <= 5)
  119. if CanSetField(fieldRating) then
  120. begin
  121.   Value := GetStringFromHTML(Page, '>AMG Rating', 'alt="', ' Stars');
  122.   if Length(Value) > 0 then
  123.   begin
  124.    SetField(fieldRating, FloatToStr(StrToFloat(Value)*2));
  125.   end;
  126. end;
  127. // Director
  128. if CanSetField(fieldDirector) then
  129. begin
  130.   SetField(fieldDirector, GetStringFromHTML(Page, '>Director', '</TD>', '</td>'));
  131. end;
  132. // Genre -> category
  133. if CanSetField(fieldCategory) then
  134. begin
  135.   if GetOption('CategoryOptions') = 1 then
  136.   Value := TextBetween(Page, 'Genre/Type </TD>', '</A>');
  137.   if Value <> '' then
  138.     begin
  139.     HTMLRemoveTags(Value);
  140.     SetField(fieldCategory, Value);
  141.     end;
  142.   if GetOption('CategoryOptions') = 2 then
  143.   Value := TextBetween(Page, 'Genre/Type </TD>', '</td>');
  144.     if Value <> '' then
  145.     begin
  146.     Value := StringReplace(Value, ',', ' /');
  147.     HTMLRemoveTags(Value);
  148.     SetField(fieldCategory, Value);
  149.     end;
  150.   if GetOption('CategoryOptions') = 3 then
  151.   SetField(fieldCategory, GetStringFromHTML(Page, '>Genre/Type', '</TD>', '</td>'));
  152. end;
  153. // Producing company  -> producer
  154. if CanSetField(fieldProducer) then
  155. begin
  156.   if GetOption('ProducerOptions') = 0 then
  157.     //SetField(fieldProducer, GetStringFromHTML(Page, 'Produced by ', '<TD>', '</TD></TR>'));
  158.     Value := TextBetween(Page, 'Produced by ', '</A></TD></TR>');
  159.     if Value <> '' then
  160.     begin
  161.     HTMLRemoveTags(Value);
  162.     SetField(fieldProducer, Value);
  163.     end;
  164.   if GetOption('ProducerOptions') = 1 then
  165.   Value := TextBetween(Page, 'Themes ', '</A></td></tr>');
  166.     if Value <> '' then
  167.     begin
  168.     Value := StringReplace(Value, ',', ' /');
  169.     HTMLRemoveTags(Value);
  170.     SetField(fieldProducer, Value);
  171.     end;
  172.   if GetOption('ProducerOptions') = 2 then
  173.   Value := TextBetween(Page, 'Tones ', '</A></td></tr>');
  174.     if Value <> '' then
  175.     begin
  176.     Value := StringReplace(Value, ',', ' /');
  177.     HTMLRemoveTags(Value);
  178.     SetField(fieldProducer, Value);
  179.     end;
  180.   if GetOption('ProducerOptions') = 3 then
  181.   Value := TextBetween(Page, 'Moods ', '</A></td></tr>');
  182.     if Value <> '' then
  183.     begin
  184.     Value := StringReplace(Value, ',', ' /');
  185.     HTMLRemoveTags(Value);
  186.     SetField(fieldProducer, Value);
  187.     end;
  188.   if GetOption('ProducerOptions') = 4 then
  189.   SetField(fieldProducer, GetStringFromHTML(Page, '>Released by', '</TD>', '</TD>'));
  190. end;
  191. // Image
  192. if CanSetPicture then
  193. begin
  194.   Value := GetStringFromHTML(Page, 'http://image.allmusic.com', '', '"');
  195.   if Length(Value) > 0 then GetPicture(Value);
  196. end;
  197. // Cast -> actors
  198. // adjust semicolons
  199. if CanSetField(fieldActors) then
  200. begin
  201.   Value := StringReplaceAll(Page, '</I></TD></TR>', '; ');
  202.   Value := GetStringFromHTML(Value, '<A Name="CAST">', '</td></tr>', '</TABLE>');
  203.   if Length(Value) > 0 then
  204.   begin
  205.     // remove double spaces if only actor name given
  206.     while Pos('  ', Value) > 0 do
  207.     Delete(Value, Pos('  ', Value), 2);
  208.     // remove trailing "; "
  209.     if Copy(Value, Length(Value) - 1, 2) = '; ' then
  210.     Value := Copy(Value, 0, Length(Value) - 2);
  211.     if GetOption('CastOptions') = 1 then
  212.       begin
  213.       SetField(fieldActors, Value);
  214.       end;
  215.     if GetOption('CastOptions') = 2 then
  216.       begin
  217.       Value := StringReplace(Value, '; ', #13#10);
  218.       HTMLRemoveTags(Value);
  219.       SetField(fieldActors, Value);
  220.       end;
  221.     if GetOption('CastOptions') = 3 then
  222.       begin
  223.       Value := StringReplace(Value, '; ', #13#10);
  224.       Value := StringReplace(Value, '-', '...');
  225.       SetField(fieldActors, Value);
  226.       end;
  227.     if GetOption('CastOptions') = 4 then
  228.       begin
  229.       Value := StringReplace(Value, '; ', ')'+#13#10);
  230.       Value := StringReplace(Value, '-', '(');
  231.       SetField(fieldActors, Value);
  232.       end;
  233.     if GetOption('CastOptions') = 5 then
  234.       begin
  235.       Value := StringReplace(Value, '; ', '), ');
  236.       Value := StringReplace(Value, '-', '(');
  237.       SetField(fieldActors, Value);
  238.       end;
  239.   end;
  240. end;
  241. // Plot synopsis
  242. if CanSetField(fieldComments) or CanSetField(fieldDescription) then
  243. begin
  244.   Value := GetStringFromHTML(Page, '<A Name="PLOT">', '</table>', '</table>');
  245.   if Length(Value) > 0 then
  246.   begin
  247.   if GetOption('SynopsisOptions') = 0 then
  248.     begin
  249.     end;
  250.   if GetOption('SynopsisOptions') = 1 then
  251.     begin
  252.     SetField(fieldDescription, 'AMG SYNOPSIS: '+Value+#13#10+#13#10);
  253.     end;
  254.   if GetOption('SynopsisOptions') = 2 then
  255.     begin
  256.     SetField(fieldComments, 'AMG SYNOPSIS: '+Value+#13#10+#13#10);
  257.     end;
  258.   end;
  259. end;
  260. // Review -> description
  261. if CanSetField(fieldComments) or CanSetField(fieldDescription) then
  262. begin
  263.   Value := GetStringFromHTML(Page, '<A Name="REVIEW">', '</table>', '</table>');
  264.   if Length(Value) > 0 then
  265.   begin
  266.     if GetOption('ReviewOptions') = 0 then
  267.       begin
  268.       end;
  269.     if GetOption('ReviewOptions') = 1 then
  270.       begin
  271.       SetField(fieldDescription, GetField(fieldDescription)+'AMG REVIEW: '+Value+#13#10+#13#10);
  272.       end;
  273.     if GetOption('ReviewOptions') = 2 then
  274.       begin
  275.       SetField(fieldComments, GetField(fieldComments)+'AMG REVIEW: '+Value+#13#10+#13#10);
  276.       end;
  277.   end;
  278. end;
  279. // Awards -> description
  280. // adjust spaces and line feeds
  281. if CanSetField(fieldComments) or CanSetField(fieldDescription) then
  282. begin
  283.   Value := StringReplaceAll(Page, '> <FONT', ''); // space before title
  284.   Value := StringReplaceAll(Value, '</FONT> </td><td WIDTH=209>', ' - '); // minus before name
  285.   Value := StringReplaceAll(Value, ' </A></FONT></td>', ' - '); // minus after name (1)
  286.   Value := StringReplaceAll(Value, ' </FONT></td>', ' - '); // minus after name (2)
  287.   Value := StringReplaceAll(Value, '</FONT> </td></tr>', + #13#10); // newline after academy name
  288.   Value := GetStringFromHTML(Value, '<A Name="AWRD">', '</td></tr>', '</TABLE>');
  289.   Value := StringReplaceAll(Value, '  ', ' ');
  290.   Value := StringReplaceAll(Value, ' - - ', ' - ');
  291.   if Length(Value) > 0 then
  292.     begin
  293.     if GetOption('AwardsOptions') = 0 then
  294.     begin
  295.     end;
  296.     if GetOption('AwardsOptions') = 1 then
  297.       begin
  298.       SetField(fieldDescription, GetField(fieldDescription)+'AWARDS:'+#13#10+Value+#13#10);
  299.       end;
  300.     if GetOption('AwardsOptions') = 2 then
  301.       begin
  302.       SetField(fieldComments, GetField(fieldComments)+'AWARDS:'+#13#10+Value+#13#10);
  303.       end;
  304.     end;
  305. end;
  306. // ProductionCredits
  307. // adjust semicolons
  308. if CanSetField(fieldComments) or CanSetField(fieldDescription) then
  309. begin
  310.   Value := StringReplaceAll(Page, '</I></TD></TR>', '; ');
  311.   Value := GetStringFromHTML(Value, '<A Name="CRED">', '</td></tr>', '</TABLE>');
  312.   if Length(Value) > 0 then
  313.   begin
  314.     // remove double spaces if only actor name given
  315.     while Pos('  ', Value) > 0 do
  316.     Delete(Value, Pos('  ', Value), 2);
  317.     // remove trailing "; "
  318.     if Copy(Value, Length(Value) - 1, 2) = '; ' then
  319.     Value := Copy(Value, 0, Length(Value) - 2);
  320.       if GetOption('FieldforCredits') = 1 then
  321.         begin
  322.           if GetOption('CreditsOptions') = 1 then
  323.             begin
  324.             Value := StringReplace(Value, '; ', #13#10);
  325.             HTMLRemoveTags(Value);
  326.             SetField(fieldDescription, GetField(fieldDescription)+'PRODUCTION CREDITS:'+#13#10+Value);
  327.             end;
  328.           if GetOption('CreditsOptions') = 2 then
  329.             begin
  330.             Value := StringReplace(Value, '; ', #13#10);
  331.             Value := StringReplace(Value, '-', '...');
  332.             SetField(fieldDescription, GetField(fieldDescription)+'PRODUCTION CREDITS:'+#13#10+Value);
  333.             end;
  334.           if GetOption('CreditsOptions') = 3 then
  335.             begin
  336.             Value := StringReplace(Value, '; ', ')'+#13#10);
  337.             Value := StringReplace(Value, '-', '(');
  338.             SetField(fieldDescription, GetField(fieldDescription)+'PRODUCTION CREDITS:'+#13#10+Value+')');
  339.             end;
  340.         end;
  341.       if GetOption('FieldforCredits') = 2 then
  342.         begin
  343.           if GetOption('CreditsOptions') = 1 then
  344.             begin
  345.             Value := StringReplace(Value, '; ', #13#10);
  346.             HTMLRemoveTags(Value);
  347.             SetField(fieldComments, GetField(fieldComments)+'PRODUCTION CREDITS:'+#13#10+Value);
  348.             end;
  349.           if GetOption('CreditsOptions') = 2 then
  350.             begin
  351.             Value := StringReplace(Value, '; ', #13#10);
  352.             Value := StringReplace(Value, '-', '...');
  353.             SetField(fieldComments, GetField(fieldComments)+'PRODUCTION CREDITS:'+#13#10+Value);
  354.             end;
  355.           if GetOption('CreditsOptions') = 3 then
  356.             begin
  357.             Value := StringReplace(Value, '; ', ')'+#13#10);
  358.             Value := StringReplace(Value, '-', '(');
  359.             SetField(fieldComments, GetField(fieldComments)+'PRODUCTION CREDITS:'+#13#10+Value+')');
  360.             end;
  361.         end;
  362.   end;
  363. end;
  364. // remove trailing newline from description or comments
  365. Value := GetField(fieldDescription);
  366. if Copy(Value, Length(Value) - 1, 2) = #13#10 then
  367. begin
  368.   Value := Copy(Value, 0, Length(Value) - 2);
  369.   SetField(fieldDescription, Value);
  370. end;
  371. Value := GetField(fieldComments);
  372. if Copy(Value, Length(Value) - 1, 2) = #13#10 then
  373. begin
  374.   Value := Copy(Value, 0, Length(Value) - 2);
  375.   SetField(fieldComments, Value);
  376. end;
  377. end;
  378.  
  379. // Adds movie titles from search results to tree
  380. procedure AddMoviesTitles(ResultsPage: TStringList);
  381. var
  382.   Page: string;
  383.   MovieTitle, MovieAddress: string;
  384. begin
  385.   Page := ResultsPage.Text;
  386.   // Every movie entry begins with string "<A HREF='/cg/avg.dll?"
  387.   while Pos('<A HREF="/cg/avg.dll?', Page) > 0 do
  388.   begin
  389.     CutBefore(Page, '<A HREF="/cg/avg.dll?');
  390.     MovieAddress := 'http://allmovie.com' + GetStringFromHTML(Page, '<A', '"', '">');
  391.     MovieTitle := GetStringFromHTML(Page, '<A', '', '</tr>');
  392.     MovieTitle := StringReplace(MovieTitle, ')', '),  ');
  393.     CutAfter(Page, '</tr>');
  394.     // add movie to list
  395.     PickTreeAdd(MovieTitle, MovieAddress);
  396.   end;
  397. end;
  398.  
  399. // Extracts single movie detail (like director, genre) from page
  400. function GetStringFromHTML(Page, StartTag, CutTag, EndTag: string): string;
  401. begin
  402.   Result := '';
  403.   // recognition tag - if present, extract detail from page, otherwise assume detail is not present
  404.   if Pos(StartTag, Page) > 0 then begin
  405.     CutBefore(Page, StartTag);
  406.     // optional cut tag helps finding right string in html page
  407.     if Length(CutTag) > 0 then
  408.       CutAfter(Page, CutTag);
  409.     // movie detail copied with html tags up to end string
  410.     Result := Copy(Page, 0, Pos(EndTag, Page) - 1);
  411.     // remove html tags and decode html string
  412.     HTMLRemoveTags(Result);
  413.     HTMLDecode(Result);
  414. //  ShowMessage('DEBUG: GetStringFromHTML - StartTag "'+StartTag+'", CutTag "'+CutTag+'", EndTag "'+EndTag+'", Result "'+Result+'" ___ '+Page);
  415.   end;
  416. end;
  417.  
  418. procedure RemovePronoun(var Str: string);
  419. var
  420.   i: Integer;
  421.   s: string;
  422.   c: char;
  423. begin
  424.   // remove pronouns
  425.   s := UpperCase(Copy(Str, 0, 4));
  426.   if (s = 'LES ') or (s = 'UNE ') or (s = 'THE ') then
  427.     Str := Copy(Str, 5, Length(Str) - 4)
  428.   else
  429.   begin
  430.     s := Copy(s, 0, 3);
  431.     if (s = 'LE ') or (s = 'UN ') then
  432.       Str := Copy(Str, 4, Length(Str) - 3)
  433.     else
  434.     begin
  435.       s := Copy(s, 0, 2);
  436.       if (s = 'L''') or (s = 'L ') or (s = 'A ') then
  437.         Str := Copy(Str, 3, Length(Str) - 2)
  438.     end;
  439.   end;
  440.   // remove non-letters, non-digits and non-spaces
  441.   s := '';
  442.   for i := 1 to Length(Str) do begin
  443.   c := StrGet(Str, i);
  444.     if ((c<'a') or (c>'z')) and
  445.        ((c<'A') or (c>'Z')) and
  446.        ((c<'0') or (c>'9')) and
  447.        (c<>' ') then
  448.     else
  449.       s := s + Copy(Str, i, 1);
  450.   end;
  451.   Str := s;
  452. end;
  453.  
  454. begin
  455.   if CheckVersion(3,5,0) then begin
  456.     MovieName := GetField(fieldOriginalTitle);
  457.     if MovieName = '' then MovieName := GetField(fieldTranslatedTitle);
  458.     if Input('All Movie Import', 'Enter title (only letters, digits and spaces):', MovieName) then
  459.     begin
  460.       if Pos('allmovie.com', MovieName) > 0 then
  461.         AnalyzePage(MovieName)
  462.       else
  463.       begin
  464.         RemovePronoun(MovieName);
  465.         AnalyzePage('http://allmovie.com/cg/avg.dll?p=avg&type=2&srch=' + StringReplace(URLEncode(MovieName), '%20', '+'));
  466.       end;
  467.     end;
  468.   end else
  469.   ShowMessage('This script requires a newer version of Ant Movie Catalog (at least the version 3.5.0)');
  470. end.
  471.